home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / lib / xm / support.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-11-22  |  13.0 KB  |  408 lines
  1. #include "../xt/xt.h"
  2. #include <Xm/Xm.h>
  3.  
  4. SYMDESCR Reason_Syms[] = {
  5.     { "none",                   XmCR_NONE },
  6.     { "help",                   XmCR_HELP },
  7.     { "value-changed",          XmCR_VALUE_CHANGED },
  8.     { "increment",              XmCR_INCREMENT },
  9.     { "decrement",              XmCR_DECREMENT },
  10.     { "page-increment",         XmCR_PAGE_INCREMENT },
  11.     { "page-decrement",         XmCR_PAGE_DECREMENT },
  12.     { "to-top",                 XmCR_TO_TOP },
  13.     { "to-bottom",              XmCR_TO_BOTTOM },
  14.     { "drag",                   XmCR_DRAG },
  15.     { "activate",               XmCR_ACTIVATE },
  16.     { "arm",                    XmCR_ARM },
  17.     { "disarm",                 XmCR_DISARM },
  18.     { "map",                    XmCR_MAP },
  19.     { "unmap",                  XmCR_UNMAP },
  20.     { "focus",                  XmCR_FOCUS },
  21.     { "losing-focus",           XmCR_LOSING_FOCUS },
  22.     { "modifying-text-value",   XmCR_MODIFYING_TEXT_VALUE },
  23.  
  24.    { "moving-insert-cursor",   XmCR_MOVING_INSERT_CURSOR },
  25.     { "execute",                XmCR_EXECUTE },
  26.     { "single-select",          XmCR_SINGLE_SELECT },
  27.     { "multiple-select",        XmCR_MULTIPLE_SELECT },
  28.     { "extended-select",        XmCR_EXTENDED_SELECT },
  29.     { "browse-select",          XmCR_BROWSE_SELECT },
  30.     { "default-action",         XmCR_DEFAULT_ACTION },
  31.     { "clipboard-data-request", XmCR_CLIPBOARD_DATA_REQUEST },
  32.     { "clipboard-data-delete",  XmCR_CLIPBOARD_DATA_DELETE },
  33.     { "cascading",              XmCR_CASCADING },
  34.     { "ok",                     XmCR_OK },
  35.     { "cancel",                 XmCR_CANCEL },
  36.     { "apply",                  XmCR_APPLY },
  37.     { "no-match",               XmCR_NO_MATCH },
  38.     { "command-entered",        XmCR_COMMAND_ENTERED },
  39.     { "command-changed",        XmCR_COMMAND_CHANGED },
  40.     { "expose",                 XmCR_EXPOSE },
  41.     { "resize",                 XmCR_RESIZE },
  42.     { "input",                  XmCR_INPUT },
  43.     { 0, 0 }
  44. };
  45.  
  46. Object Get_Any_CB (p) XmAnyCallbackStruct *p; {
  47.     Object args = Null, ret = Null;
  48.     GC_Node2;
  49.  
  50.     GC_Link2 (ret, args);
  51.     if (p->event) {
  52.         args = Get_Event_Args (p->event);
  53.         ret = Copy_List (args);
  54.         Destroy_Event_Args (args);
  55.     }
  56.     ret = Cons (Bits_To_Symbols ((unsigned long)p->reason, 0, Reason_Syms),
  57.           ret);
  58.     GC_Unlink;
  59.     return ret;
  60. }
  61.  
  62. Object Get_Selection_CB (p) XmSelectionBoxCallbackStruct *p; {
  63.     Object ret, s;
  64.     char *text;
  65.     GC_Node2;
  66.  
  67.     if (!XmStringGetLtoR (p->value, XmSTRING_DEFAULT_CHARSET, &text))
  68.     text = "";
  69.     ret = s = Make_String (text, strlen (text));
  70.     GC_Link2 (ret, s);
  71.     ret = Cons (ret, Null);
  72.     s = Get_Any_CB ((XmAnyCallbackStruct *)p);
  73.     ret = Cons (Cdr (s), ret);
  74.     ret = Cons (Car (s), ret);
  75.     GC_Unlink;
  76.     return ret;
  77. }
  78.  
  79. static XtArgVal Scheme_To_String_Table (x) Object x; {
  80.     Object t;
  81.     char *s;
  82.     XmString *tab;
  83.     int i = 0;
  84.     Declare_C_Strings;
  85.  
  86.     tab = (XmString *)XtMalloc (P_Length (x) * sizeof (XmString));
  87.     /* tab is never freed since the converter must return a new address
  88.      * each time it is called.
  89.      */
  90.     for (t = x; TYPE(t) == T_Pair; t = Cdr (t)) {
  91.     Make_C_String (Car (t), s);
  92.     tab[i++] = XmStringCreate (s, XmSTRING_DEFAULT_CHARSET);
  93.     }
  94.     Dispose_C_Strings;
  95.     return (XtArgVal)tab;
  96. }
  97.  
  98. static Object P_Update_Display (w) Object w; {
  99.    Check_Widget (w);
  100.     XmUpdateDisplay (WIDGET(w)->widget);
  101.     return Void;
  102. }
  103.  
  104. static Object S_KeySym (x) XtArgVal x; {
  105.    return Make_Char ((int)x);
  106. }
  107.  
  108. static XtArgVal C_KeySym (x) Object x; {
  109.    Check_Type (x, T_Character); return (XtArgVal)CHAR(x);
  110. }
  111.  
  112. static Object S_HorizontalPosition (x) XtArgVal x; {
  113.    return Make_Integer ((Position)x);
  114. }
  115.  
  116. static Object S_VerticalPosition (x) XtArgVal x; {
  117.    return Make_Integer ((Position)x);
  118. }
  119.  
  120. static Object S_HorizontalDimension (x) XtArgVal x; {
  121.    return Make_Integer ((Position)x);
  122. }
  123.  
  124. static Object S_VerticalDimension (x) XtArgVal x; {
  125.    return Make_Integer ((Position)x);
  126. }
  127.  
  128. static XtArgVal C_HorizontalPosition (x) Object x; {
  129.    return (XtArgVal)Get_Integer (x);
  130. }
  131.  
  132. static XtArgVal C_VerticalPosition (x) Object x; {
  133.    return (XtArgVal)Get_Integer (x);
  134. }
  135.  
  136. static XtArgVal C_HorizontalDimension (x) Object x; {
  137.    return (XtArgVal)Get_Integer (x);
  138. }
  139.  
  140. static XtArgVal C_VerticalDimension (x) Object x; {
  141.    return (XtArgVal)Get_Integer (x);
  142. }
  143.  
  144. static Object S_ShellHorizPos (x) XtArgVal x; {
  145.    return Make_Integer ((Position)x);
  146. }
  147.  
  148. static Object S_ShellVertPos (x) XtArgVal x; {
  149.    return Make_Integer ((Position)x);
  150. }
  151.  
  152. static Object S_ShellHorizDim (x) XtArgVal x; {
  153.    return Make_Integer ((Position)x);
  154. }
  155.  
  156. static Object S_ShellVertDim (x) XtArgVal x; {
  157.    return Make_Integer ((Position)x);
  158. }
  159.  
  160. static XtArgVal C_ShellHorizPos (x) Object x; {
  161.    return (XtArgVal)Get_Integer (x);
  162. }
  163.  
  164. static XtArgVal C_ShellVertPos (x) Object x; {
  165.    return (XtArgVal)Get_Integer (x);
  166. }
  167.  
  168. static XtArgVal C_ShellHorizDim (x) Object x; {
  169.    return (XtArgVal)Get_Integer (x);
  170. }
  171.  
  172. static XtArgVal C_ShellVertDim (x) Object x; {
  173.    return (XtArgVal)Get_Integer (x);
  174. }
  175.  
  176. static Object S_HorizontalScrollBar (x) XtArgVal x; {
  177.    return Make_Widget_Foreign ((Widget)x);
  178. }
  179.  
  180. static Object S_VerticalScrollBar (x) XtArgVal x; {
  181.    return Make_Widget_Foreign ((Widget)x);
  182. }
  183.  
  184. static Object S_WorkWindow (x) XtArgVal x; {
  185.    return Make_Widget_Foreign ((Widget)x);
  186. }
  187.  
  188. static Object S_CommandWindow (x) XtArgVal x; {
  189.    return Make_Widget_Foreign ((Widget)x);
  190. }
  191.  
  192. static Object S_MenuBar (x) XtArgVal x; {
  193.    return Make_Widget_Foreign ((Widget)x);
  194. }
  195.  
  196. static Object S_SubMenuId (x) XtArgVal x; {
  197.    return Make_Widget_Foreign ((Widget)x);
  198. }
  199.  
  200. static Object S_MenuHistory (x) XtArgVal x; {
  201.    return Make_Widget_Foreign ((Widget)x);
  202. }
  203.  
  204. static Object S_MenuHelpWidget (x) XtArgVal x; {
  205.    return Make_Widget_Foreign ((Widget)x);
  206. }
  207.  
  208. static Object S_BottomWidget (x) XtArgVal x; {
  209.    return Make_Widget_Foreign ((Widget)x);
  210. }
  211.  
  212. static Object S_LeftWidget (x) XtArgVal x; {
  213.    return Make_Widget_Foreign ((Widget)x);
  214. }
  215.  
  216. static Object S_RightWidget (x) XtArgVal x; {
  217.    return Make_Widget_Foreign ((Widget)x);
  218. }
  219.  
  220. static Object S_TopWidget (x) XtArgVal x; {
  221.    return Make_Widget_Foreign ((Widget)x);
  222. }
  223.  
  224. static XtArgVal C_HorizontalScrollBar (x) Object x; {
  225.    extern WidgetClass xmScrollBarWidgetClass;
  226.     Check_Widget_Class (x, xmScrollBarWidgetClass);
  227.     return (XtArgVal)WIDGET(x)->widget;
  228. }
  229.  
  230. static XtArgVal C_VerticalScrollBar (x) Object x; {
  231.    extern WidgetClass xmScrollBarWidgetClass;
  232.     Check_Widget_Class (x, xmScrollBarWidgetClass);
  233.     return (XtArgVal)WIDGET(x)->widget;
  234. }
  235.  
  236. static XtArgVal C_WorkWindow (x) Object x; {
  237.    Check_Widget (x); return (XtArgVal)WIDGET(x)->widget;
  238. }
  239.  
  240. static XtArgVal C_CommandWindow (x) Object x; {
  241.    Check_Widget (x); return (XtArgVal)WIDGET(x)->widget;
  242. }
  243.  
  244. static XtArgVal C_MenuBar (x) Object x; {
  245.    Check_Widget (x); return (XtArgVal)WIDGET(x)->widget;
  246. }
  247.  
  248. static XtArgVal C_SubMenuId (x) Object x; {
  249.    Check_Widget (x); return (XtArgVal)WIDGET(x)->widget;
  250. }
  251.  
  252. static XtArgVal C_MenuHistory (x) Object x; {
  253.    Check_Widget (x); return (XtArgVal)WIDGET(x)->widget;
  254. }
  255.  
  256. static XtArgVal C_MenuHelpWidget (x) Object x; {
  257.    Check_Widget (x); return (XtArgVal)WIDGET(x)->widget;
  258. }
  259.  
  260. static XtArgVal C_BottomWidget (x) Object x; {
  261.    Check_Widget (x); return (XtArgVal)WIDGET(x)->widget;
  262. }
  263.  
  264. static XtArgVal C_LeftWidget (x) Object x; {
  265.    Check_Widget (x); return (XtArgVal)WIDGET(x)->widget;
  266. }
  267.  
  268. static XtArgVal C_RightWidget (x) Object x; {
  269.    Check_Widget (x); return (XtArgVal)WIDGET(x)->widget;
  270. }
  271.  
  272. static XtArgVal C_TopWidget (x) Object x; {
  273.    Check_Widget (x); return (XtArgVal)WIDGET(x)->widget;
  274. }
  275.  
  276. static Object S_ApplyCallback (x) XtArgVal x; {
  277.    return Get_Selection_CB ((XmSelectionBoxCallbackStruct *)x);
  278. }
  279.  
  280. static Object S_CancelCallback (x) XtArgVal x; {
  281.    return Get_Selection_CB ((XmSelectionBoxCallbackStruct *)x);
  282. }
  283.  
  284. static Object S_NoMatchCallback (x) XtArgVal x; {
  285.    return Get_Selection_CB ((XmSelectionBoxCallbackStruct *)x);
  286. }
  287.  
  288. static Object S_OkCallback (x) XtArgVal x; {
  289.    return Get_Selection_CB ((XmSelectionBoxCallbackStruct *)x);
  290. }
  291.  
  292. static Object S_HelpCallback (x) XtArgVal x; {
  293.    return Get_Any_CB ((XmAnyCallbackStruct *)x);
  294. }
  295.  
  296. static Object S_ActivateCallback (x) XtArgVal x; {
  297.    return Get_Any_CB ((XmAnyCallbackStruct *)x);
  298. }
  299.  
  300. static Object S_ArmCallback (x) XtArgVal x; {
  301.    return Get_Any_CB ((XmAnyCallbackStruct *)x);
  302. }
  303.  
  304. static Object S_DisarmCallback (x) XtArgVal x; {
  305.    return Get_Any_CB ((XmAnyCallbackStruct *)x);
  306. }
  307.  
  308. static Object S_CascadingCallback (x) XtArgVal x; {
  309.    return Get_Any_CB ((XmAnyCallbackStruct *)x);
  310. }
  311.  
  312. static Object S_ExposeCallback (x) XtArgVal x; {
  313.    return Get_Any_CB ((XmAnyCallbackStruct *)x);
  314. }
  315.  
  316. static Object S_InputCallback (x) XtArgVal x; {
  317.    return Get_Any_CB ((XmAnyCallbackStruct *)x);
  318. }
  319.  
  320. static Object S_ResizeCallback (x) XtArgVal x; {
  321.    return Get_Any_CB ((XmAnyCallbackStruct *)x);
  322. }
  323.  
  324. static Object S_XmString (x) XtArgVal x; {
  325.    char *text;
  326.     if (!XmStringGetLtoR ((XmString)x, XmSTRING_DEFAULT_CHARSET, &text))
  327.     text = "";
  328.     return Make_String (text, strlen (text));
  329. }
  330.  
  331. static XtArgVal C_XmString (x) Object x; {
  332.    char *s;
  333.     Object ret;
  334.     Declare_C_Strings;
  335.     Make_C_String (x, s);
  336.     ret = (XtArgVal)XmStringCreateLtoR (s, XmSTRING_DEFAULT_CHARSET);
  337.     Dispose_C_Strings;
  338.     return ret;
  339. }
  340.  
  341. static XtArgVal C_XmStringTable (x) Object x; {
  342.    return Scheme_To_String_Table (x);
  343. }
  344.  
  345. init_support () {
  346.     XtResourceList r = 0;
  347.     Define_Class ("manager", xmManagerWidgetClass, r, 0);
  348.     Define_Class ("primitive", xmPrimitiveWidgetClass, r, 0);
  349.     Define_Primitive (P_Update_Display, "update-display", 1, 1, EVAL);
  350.     Define_Converter_To_C ("XmStringTable", C_XmStringTable);
  351.     Define_Converter_To_C ("XmString", C_XmString);
  352.     Define_Converter_To_Scheme ("XmString", S_XmString);
  353.     Define_Converter_To_Scheme ("resizeCallback", S_ResizeCallback);
  354.     Define_Converter_To_Scheme ("inputCallback", S_InputCallback);
  355.     Define_Converter_To_Scheme ("exposeCallback", S_ExposeCallback);
  356.     Define_Converter_To_Scheme ("cascadingCallback", S_CascadingCallback);
  357.     Define_Converter_To_Scheme ("disarmCallback", S_DisarmCallback);
  358.     Define_Converter_To_Scheme ("armCallback", S_ArmCallback);
  359.     Define_Converter_To_Scheme ("activateCallback", S_ActivateCallback);
  360.     Define_Converter_To_Scheme ("helpCallback", S_HelpCallback);
  361.     Define_Converter_To_Scheme ("okCallback", S_OkCallback);
  362.     Define_Converter_To_Scheme ("noMatchCallback", S_NoMatchCallback);
  363.     Define_Converter_To_Scheme ("cancelCallback", S_CancelCallback);
  364.     Define_Converter_To_Scheme ("applyCallback", S_ApplyCallback);
  365.     Define_Converter_To_C ("topWidget", C_TopWidget);
  366.     Define_Converter_To_C ("rightWidget", C_RightWidget);
  367.     Define_Converter_To_C ("leftWidget", C_LeftWidget);
  368.     Define_Converter_To_C ("bottomWidget", C_BottomWidget);
  369.     Define_Converter_To_C ("menuHelpWidget", C_MenuHelpWidget);
  370.     Define_Converter_To_C ("menuHistory", C_MenuHistory);
  371.     Define_Converter_To_C ("subMenuId", C_SubMenuId);
  372.     Define_Converter_To_C ("menuBar", C_MenuBar);
  373.     Define_Converter_To_C ("commandWindow", C_CommandWindow);
  374.     Define_Converter_To_C ("workWindow", C_WorkWindow);
  375.     Define_Converter_To_C ("verticalScrollBar", C_VerticalScrollBar);
  376.     Define_Converter_To_C ("horizontalScrollBar", C_HorizontalScrollBar);
  377.     Define_Converter_To_Scheme ("topWidget", S_TopWidget);
  378.     Define_Converter_To_Scheme ("rightWidget", S_RightWidget);
  379.     Define_Converter_To_Scheme ("leftWidget", S_LeftWidget);
  380.     Define_Converter_To_Scheme ("bottomWidget", S_BottomWidget);
  381.     Define_Converter_To_Scheme ("menuHelpWidget", S_MenuHelpWidget);
  382.     Define_Converter_To_Scheme ("menuHistory", S_MenuHistory);
  383.     Define_Converter_To_Scheme ("subMenuId", S_SubMenuId);
  384.     Define_Converter_To_Scheme ("menuBar", S_MenuBar);
  385.     Define_Converter_To_Scheme ("commandWindow", S_CommandWindow);
  386.     Define_Converter_To_Scheme ("workWindow", S_WorkWindow);
  387.     Define_Converter_To_Scheme ("verticalScrollBar", S_VerticalScrollBar);
  388.     Define_Converter_To_Scheme ("horizontalScrollBar", S_HorizontalScrollBar);
  389.     Define_Converter_To_C ("ShellVertDim", C_ShellVertDim);
  390.     Define_Converter_To_C ("ShellHorizDim", C_ShellHorizDim);
  391.     Define_Converter_To_C ("ShellVertPos", C_ShellVertPos);
  392.     Define_Converter_To_C ("ShellHorizPos", C_ShellHorizPos);
  393.     Define_Converter_To_Scheme ("ShellVertDim", S_ShellVertDim);
  394.     Define_Converter_To_Scheme ("ShellHorizDim", S_ShellHorizDim);
  395.     Define_Converter_To_Scheme ("ShellVertPos", S_ShellVertPos);
  396.     Define_Converter_To_Scheme ("ShellHorizPos", S_ShellHorizPos);
  397.     Define_Converter_To_C ("VerticalDimension", C_VerticalDimension);
  398.     Define_Converter_To_C ("HorizontalDimension", C_HorizontalDimension);
  399.     Define_Converter_To_C ("VerticalPosition", C_VerticalPosition);
  400.     Define_Converter_To_C ("HorizontalPosition", C_HorizontalPosition);
  401.     Define_Converter_To_Scheme ("VerticalDimension", S_VerticalDimension);
  402.     Define_Converter_To_Scheme ("HorizontalDimension", S_HorizontalDimension);
  403.     Define_Converter_To_Scheme ("VerticalPosition", S_VerticalPosition);
  404.     Define_Converter_To_Scheme ("HorizontalPosition", S_HorizontalPosition);
  405.     Define_Converter_To_C ("KeySym", C_KeySym);
  406.     Define_Converter_To_Scheme ("KeySym", S_KeySym);
  407. }
  408.